home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / swaga-c / copymove.swg / 0019_File Copy Routine.pas < prev    next >
Pascal/Delphi Source File  |  1993-10-28  |  15KB  |  425 lines
  1.  
  2.               (* Compiler directives.                               *)
  3.  {$A+,B-,D-,E-,F-,I+,N-,O-,R-,S-,V+}
  4.  
  5.               (* STACK, HEAP memory directives.                     *)
  6.  {$M 1024, 0, 0}
  7.  
  8.               (* Public domain file-copy program.                   *)
  9.               (* Guy McLoughlin - August 23, 1992.                  *)
  10. program MCopy;
  11.  
  12. uses          (* We need this unit for the paramcount, paramstr,    *)
  13.   Dos;        (* fsearch, fexpand, fsplit routines.                 *)
  14.  
  15. const
  16.               (* Carridge-return + Line-feed constant.              *)
  17.   coCrLf = #13#10;
  18.  
  19.               (* Size of the buffer we're going to use.             *)
  20.   coBuffSize = 61440;
  21.  
  22. type
  23.               (* User defined file read/write buffer.               *)
  24.   arBuffSize = array[1..coBuffSize] of byte;
  25.  
  26. var
  27.               (* Path display width.                                *)
  28.   byDispWidth : byte;
  29.  
  30.               (* Variable to record the number of files copied.     *)
  31.   woCopyCount,
  32.               (* Variable to record the number of bytes read.       *)
  33.   woBytesRead,
  34.               (* Variable to record the number of bytes written.    *)
  35.   woBytesWritten : word;
  36.  
  37.               (* Variable to record the size in bytes of IN-file.   *)
  38.   loInSize,
  39.               (* Variable to record the number of bytes copied.     *)
  40.   loByteProc : longint;
  41.  
  42.               (* Variables for TP "Fsplit" routine.                 *)
  43.   stName : namestr;
  44.   stExt  : extstr;
  45.  
  46.               (* Directory-string variables.                        *)
  47.   stDirTo,
  48.   stDirFrom : dirstr;
  49.  
  50.               (* Path-string variables.                             *)
  51.   stPathTo,
  52.   stPathFrom,
  53.   stPathTemp : pathstr;
  54.  
  55.               (* Array used to buffer file reads/writes.            *)
  56.   arBuffer : arBuffSize;
  57.  
  58.               (* Directory search-record.                           *)
  59.   rcSearchTemp : searchrec;
  60.  
  61.               (* IN file-variable.                                  *)
  62.   fiIN,
  63.               (* OUT file-variable.                                 *)
  64.   fiOUT : file;
  65.  
  66.  
  67.    (***** Handle file errors.                                       *)
  68.    procedure ErrorHandler( byErrorNum : byte);
  69.    begin
  70.      case byErrorNum of
  71.  
  72.        1 : begin
  73.              writeln(coCrLf, ' (SYNTAX) MCOPY <path1><filespec1>' +
  74.                              ' <path2><filename2>');
  75.              writeln(coCrLf, ' (USAGE)  MCOPY c:\utils\*.doc' +
  76.                              ' c:\temp\master.doc');
  77.              writeln('          MCOPY   \utils\*.doc    ' +
  78.                      '\temp\master.doc');
  79.              writeln(coCrLf, ' (Copies all files with the ''.doc''' +
  80.                              ' extension from ''c:\utils'')');
  81.              writeln(' (directory, to ''master.doc'' in the ' +
  82.                      '''c:\temp'' directory.    )');
  83.              writeln(coCrLf, ' ( Public-domain utility by Guy ' +
  84.                      'McLoughlin  \  August 1992  )')
  85.            end;
  86.  
  87.        2 : writeln(coCrLf,
  88.                   ' Error : <path1><filespec1> = <path2><filename2>');
  89.  
  90.        3 : writeln(coCrLf, ' Directory not found ---> ', stDirFrom);
  91.  
  92.        4 : writeln(coCrLf, ' Directory not found ---> ', stDirTo);
  93.  
  94.        5 : writeln(coCrLf, ' Error opening ---> ', stPathTo);
  95.  
  96.        6 : writeln(coCrLf, ' File copy aborted');
  97.  
  98.        7 : writeln(coCrLf, ' Error creating ---> ', stPathTo);
  99.  
  100.        8 : writeln(coCrLf, ' Error opening ---> ', stPathTemp);
  101.  
  102.        9 : writeln(coCrLf, ' Error with disk I/O ')
  103.  
  104.      end;     (* case byErrorNum.                                   *)
  105.  
  106.      halt
  107.    end;       (* ErrorHandler.                                      *)
  108.  
  109.  
  110.    (***** Determine if a file exists.                               *)
  111.    function FileExist(FileName : pathstr) : boolean;
  112.    begin
  113.      FileExist := (FSearch(FileName, '') <> '')
  114.    end;       (* FileExist.                                         *)
  115.  
  116.  
  117.    (***** Determine if a directory exists.                          *)
  118.    function DirExist(stDir : dirstr) : boolean;
  119.    var
  120.      woFattr : word;
  121.      fiTemp  : file;
  122.    begin
  123.      assign(fiTemp, (stDir + '.'));
  124.      getfattr(fiTemp, woFattr);
  125.      if (doserror <> 0) then
  126.        DirExist := false
  127.      else
  128.        DirExist := ((woFattr and directory) <> 0)
  129.    end;       (* DirExist.                                          *)
  130.  
  131.  
  132.    (***** Clear the keyboard-buffer.                                *)
  133.    procedure ClearKeyBuff; assembler;
  134.    asm
  135.      @1: mov ah, 01h
  136.          int 16h
  137.          jz  @2
  138.          mov ah, 00h
  139.          int 16h
  140.          jmp @1
  141.      @2:
  142.    end;       (* ClearKeyBuff                                       *)
  143.  
  144.  
  145.    (***** Read a key-press.                                         *)
  146.    function ReadKeyChar : char; assembler;
  147.    asm
  148.      mov ah, 00h
  149.      int 16h
  150.    end;        (* ReadKeyChar.                                      *)
  151.  
  152.  
  153.    (***** Obtain user's choice.                                     *)
  154.    function UserChoice : char;
  155.    var
  156.      Key : char;
  157.    begin
  158.      ClearKeyBuff;
  159.      repeat
  160.        Key := upcase(ReadKeyChar)
  161.      until (Key in ['A', 'O', 'Q']);
  162.      writeln(Key);
  163.      UserChoice := Key
  164.    end;       (* UserChoice.                                        *)
  165.  
  166.  
  167.    (***** Returns all valid wildcard names for a specific directory.*)
  168.    (*     When the last file is found, the next call will return an *)
  169.    (*     empty string.                                             *)
  170.    (*                                                               *)
  171.    (* NOTE: Standard TP DOS unit must be listed in your program's   *)
  172.    (*       "uses" directive, for this routine to compile.          *)
  173.  
  174.    function WildCardNames({ input}     stPath   : pathstr;
  175.                                        woAttr   : word;
  176.                           {update} var stDir    : dirstr;
  177.                                    var rcSearch : searchrec)
  178.                           {output}              : pathstr;
  179.    var
  180.               (* Fsplit variables.                                  *)
  181.      stName : namestr;
  182.      stExt  : extstr;
  183.    begin
  184.               (* If the search-record "name" field is empty, then   *)
  185.               (* initialize it with the first matching file found.  *)
  186.      if (rcSearch.name = '') then
  187.        begin
  188.               (* Obtain directory-string from passed path-string.   *)
  189.          fsplit(stPath, stDir, stName, stExt);
  190.  
  191.               (* Find first match of path-string.                   *)
  192.          findfirst(stPath, woAttr, rcSearch);
  193.  
  194.               (* If a matching file was found, then return full     *)
  195.               (* path-name.                                         *)
  196.          if (doserror = 0) and (rcSearch.name <> '') then
  197.            WildCardNames := (stDir + rcSearch.name)
  198.          else
  199.               (* No match found, return empty string.               *)
  200.            WildCardNames := ''
  201.        end
  202.      else
  203.               (* Search-record "name" field is not empty, so        *)
  204.               (* continue searching for matches.                    *)
  205.        begin
  206.          findnext(rcSearch);
  207.  
  208.               (* If no error occurred, then match was found...      *)
  209.          if (doserror = 0) then
  210.            WildCardNames := (stDir + rcSearch.name)
  211.          else
  212.               (* No match found. Re-set search-record "name" field, *)
  213.               (* and return empty path-string.                      *)
  214.            begin
  215.              rcSearch.name := '';
  216.              WildCardNames := ''
  217.            end
  218.        end
  219.    end;
  220.  
  221.  
  222.    (***** Pad a string with extras spaces on the right.             *)
  223.    function PadR(stIn : string; bySize : byte) : string;
  224.    begin
  225.      fillchar(stIn[succ(length(stIn))], (bySize - length(stIn)) ,' ');
  226.      inc(stIn[0], (bySize - length(stIn)));
  227.      PadR := stIn
  228.    end;       (* PadR.                                              *)
  229.  
  230.  
  231.               (* Main program execution block.                      *)
  232. BEGIN
  233.               (* If too many or too few parameters, display syntax. *)
  234.   if (paramcount <> 2) then
  235.     ErrorHandler(1);
  236.  
  237.               (* Assign program parameters to string variables.     *)
  238.   stPathFrom := paramstr(1);
  239.   stPathTo   := paramstr(2);
  240.  
  241.               (* Make sure full path-string is used.                *)
  242.   stPathFrom := fexpand(stPathFrom);
  243.   stPathTo   := fexpand(stPathTo);
  244.   stPathTemp := stPathFrom;
  245.  
  246.               (* Check if IN-Filename is the same as OUT-Filename.  *)
  247.   if (stPathFrom = stPathTo) then
  248.     ErrorHandler(2);
  249.  
  250.               (* Seperate directory-strings from path-strings.      *)
  251.   fsplit(stPathFrom, stDirFrom, stName, stExt);
  252.   fsplit(stPathTo, stDirTo, stName, stExt);
  253.  
  254.               (* Make sure that "From" directory exists.            *)
  255.   if NOT DirExist(stDirFrom) then
  256.     ErrorHandler(3);
  257.  
  258.               (* Make sure that "To" directory exists.              *)
  259.   if NOT DirExist(stDirTo) then
  260.     ErrorHandler(4);
  261.  
  262.               (* Determine the full path display width.             *)
  263.   if (stDirFrom[0] > stDirTo[0]) then
  264.     byDispWidth := length(stDirFrom) + 12
  265.   else
  266.     byDispWidth := length(stDirTo) + 12;
  267.  
  268.               (* Check if the OUT-File does exist, then...          *)
  269.   if FileExist(stPathTo) then
  270.     begin
  271.               (* Ask if user wants to append/overwrite file or quit.*)
  272.       writeln(coCrLf, ' File exists ---> ', stPathTo);
  273.       write(coCrLf, ' Append / Overwrite / Quit  [A,O,Q]? ');
  274.  
  275.               (* Obtain user's response.                            *)
  276.       case UserChoice of
  277.         'A' : begin
  278.               (* Open the OUT-file to write to it.                  *)
  279.                 assign(fiOUT, stPathTo);
  280.                 {$I-}
  281.                 reset(fiOUT, 1);
  282.                 {$I+}
  283.  
  284.               (* If there is an error opening the OUT-file, inform  *)
  285.               (* the user of it, and halt the program.              *)
  286.                 if (ioresult <> 0) then
  287.                   ErrorHandler(5);
  288.  
  289.               (* Seek to end of file, so that data can be appended. *)
  290.                 seek(fiOUT, filesize(fiOUT))
  291.               end;
  292.  
  293.         'O' : begin
  294.               (* Open the OUT-file to write to it.                  *)
  295.                 assign(fiOUT, stPathTo);
  296.                 {$I-}
  297.                 rewrite(fiOUT, 1);
  298.                 {$I+}
  299.  
  300.               (* If there is an error opening the OUT-file, inform  *)
  301.               (* the user of it, and halt the program.              *)
  302.                 if (ioresult <> 0) then
  303.                   ErrorHandler(5)
  304.               end;
  305.  
  306.         'Q' : ErrorHandler(6)
  307.  
  308.       end     (* case UserChoice.                                   *)
  309.  
  310.     end
  311.  
  312.   else        (* OUT-file does not exist.                           *)
  313.  
  314.     begin
  315.               (* Create the OUT-file to write to.                   *)
  316.       assign(fiOUT, stPathTo);
  317.       {$I-}
  318.       rewrite(fiOUT, 1);
  319.       {$I+}
  320.  
  321.               (* If there is an error creating the OUT-file, inform *)
  322.               (* the user of it, and halt the program.              *)
  323.       if (ioresult <> 0) then
  324.         ErrorHandler(7)
  325.     end;
  326.  
  327.               (* Clear the search-record, before begining.          *)
  328.   fillchar(rcSearchTemp, sizeof(rcSearchTemp), 0);
  329.  
  330.               (* Initialize copy-counter.                           *)
  331.   woCopyCount := 0;
  332.  
  333.               (* Set current file-mode to "read-only".              *)
  334.   filemode := 0;
  335.  
  336.   writeln;
  337.  
  338.               (* Repeat... ...Until (stPathTemp = '').              *)
  339.   repeat
  340.               (* Search for vaild filenames.                        *)
  341.     stPathTemp := WildCardNames(stPathTemp, archive, stDirFrom,
  342.                                 rcSearchTemp);
  343.  
  344.               (* If file search was successful, then...             *)
  345.     if (stPathTemp <> '') then
  346.       begin
  347.               (* Open the IN-file to read it.                       *)
  348.         assign(fiIN, stPathTemp);
  349.         {$I-}
  350.         reset(fiIN, 1);
  351.         {$I+}
  352.  
  353.               (* If there is an error opening the IN-file, inform   *)
  354.               (* the user of it, and halt the program.              *)
  355.         if (ioresult <> 0) then
  356.           begin
  357.             close(fiOUT);
  358.             erase(fiOUT);
  359.             ErrorHandler(8)
  360.           end;
  361.  
  362.               (* Determine the size of the IN-file.                 *)
  363.         loInSize := filesize(fiIN);
  364.  
  365.               (* Set the number of bytes processed to 0.            *)
  366.         loByteProc := 0;
  367.  
  368.               (* Repeat... ...Until the IN-file has been completely *)
  369.               (* copied.                                            *)
  370.         repeat
  371.  
  372.               (* Read the IN-file into the file-buffer.             *)
  373.           blockread(fiIN, arBuffer, coBuffSize, woBytesRead);
  374.  
  375.               (* Write the file-buffer to the OUT-file.             *)
  376.           blockwrite(fiOUT, arBuffer, woBytesRead, woBytesWritten);
  377.  
  378.               (* If there is a problem writing the bytes to the     *)
  379.               (* OUT-file, let the user know, and halt the program. *)
  380.           if (woBytesWritten <> woBytesRead) then
  381.             begin
  382.               close(fiIN);
  383.               close(fiOUT);
  384.               erase(fiOut);
  385.               ErrorHandler(9)
  386.             end
  387.           else
  388.               (* Advance the bytes-processed variable by the        *)
  389.               (* number of bytes written to the OUT-file.           *)
  390.             inc(loByteProc, woBytesWritten)
  391.  
  392.               (* Repeat... ...Until the complete IN-file has been   *)
  393.               (* processed.                                         *)
  394.         until (loByteProc = loInSize);
  395.  
  396.               (* Close the IN-file that has been copied.            *)
  397.         close(fiIN);
  398.  
  399.               (* Increment copy-counter by 1.                       *)
  400.         inc(woCopyCount);
  401.  
  402.               (* Let the user know that we've finished copying file.*)
  403.         writeln(' ', PadR(stPathTemp, byDispWidth),' COPIED TO ---> ',
  404.                 stPathTo);
  405.  
  406.       end     (* If (stPathTemp <> '') then...                      *)
  407.  
  408.               (* Repeat... ...Until no more files are found.        *)
  409.   until (stPathTemp = '');
  410.  
  411.               (* Close the OUT-file.                                *)
  412.   close(fiOUT);
  413.  
  414.               (* Display the number of files copied.                *)
  415.   if (woCopyCount = 0) then
  416.     begin
  417.       erase(fiOut);
  418.       writeln(coCrLf, ' No matching files found ---> ', stPathFrom)
  419.     end
  420.   else
  421.     writeln(coCrLf, ' ', woCopyCount, ' Files copied')
  422. END.
  423.  
  424.  
  425.